j_ps <- phyloseq(otu_table(j_ps), sample_data(j_ps), tax_table(j_ps))
assign(paste0(i, "_", j, "_", "Above_Prediction", "_ps"), j_ps)
x <- which(spp.out$predictions$fit_class == "As predicted")
j_ps <- prune_taxa(taxa_names(i_ps) %in% taxa_names(i_ps)[x], i_ps)
j_ps <- merge_samples(j_ps, "Country")
j_ps@sam_data$Country <- i
j_ps@sam_data$Age_Group <- j
j_ps@sam_data$Prediction <- "As_Predicted"
j_ps@sam_data$Original_Name <- sample_names(j_ps)
sample_names(j_ps) <- paste0(i, "_", j, "_", j_ps@sam_data$Prediction)
j_ps <- phyloseq(otu_table(j_ps), sample_data(j_ps), tax_table(j_ps))
assign(paste0(i, "_", j, "_", "As_Predicted", "_ps"), j_ps)
x <- which(spp.out$predictions$fit_class == "Below prediction")
j_ps <- prune_taxa(taxa_names(i_ps) %in% taxa_names(i_ps)[x], i_ps)
j_ps <- merge_samples(j_ps, "Country")
j_ps@sam_data$Country <- i
j_ps@sam_data$Age_Group <- j
j_ps@sam_data$Prediction <- "Below_Prediction"
j_ps@sam_data$Original_Name <- sample_names(j_ps)
sample_names(j_ps) <- paste0(i, "_", j, "_", j_ps@sam_data$Prediction)
j_ps <- phyloseq(otu_table(j_ps), sample_data(j_ps), tax_table(j_ps))
assign(paste0(i, "_", j, "_", "Below_Prediction", "_ps"), j_ps)
df <- data.frame(t(table(spp.out$predictions$fit_class)))
row_var <- paste0(i, "_", j)
fitstats_df[row_var, 1] <- df[1,3]
fitstats_df[row_var, 2] <- df[2,3]
fitstats_df[row_var, 3] <- df[3,3]
fitstats_df[row_var, 4] <- spp.out$fitstats$Rsqr
fitstats_df[row_var, 5] <- spp.out$fitstats$m
fitstats_df[row_var, 6] <- spp.out$fitstats$m.ci
fitstats_df[row_var, 7] <- spp.out$fitstats$Richness
fitstats_df[row_var, 8] <- spp.out$fitstats$Samples
fitstats_df[row_var, 9] <- spp.out$fitstats$Detect
fitstats_df[row_var, 10] <- length(unique(i_ps@sam_data$Subject_ID))
fitstats_df[row_var, 11] <- spp.out$fitstats$RMSE
}
}
prediction_df$Country <- factor(prediction_df$Country, levels = country_list)
prediction_df$Age_Group <- factor(prediction_df$Age_Group, levels = age_group_list)
fitstats_df$Country <- factor(fitstats_df$Country, levels = country_list)
fitstats_df$Age_Group <- factor(fitstats_df$Age_Group, levels = age_group_list)
p <- ggplot(data = prediction_df)
p <- p + geom_line(aes(x = log(p), y = freq.pred), color = "darkgray")
p <- p + geom_line(aes(x = log(p), y = pred.lwr), color = "darkgray", linetype = "dashed")
p <- p + geom_line(aes(x = log(p), y = pred.upr), color = "darkgray", linetype = "dashed")
p <-p + geom_ribbon(aes(x = log(p), ymin=pred.lwr,ymax=pred.upr), alpha=0.4, fill="darkgray")
p <- p + geom_point(aes(x = log(p), y = freq, fill = fit_class),
shape = 21, color = "black", size = 2, alpha = 0.5)
p <- p + scale_fill_manual(name = "Prediction",
values = Prediction_pal,
breaks = c("Above prediction", "As predicted",
"Below prediction", "NA"))
p <- p + facet_grid(Country ~ Age_Group, labeller = labeller(
Age_Group = c("1_to_3months" = "1 - 3 Months",
"4_to_6months" = "4 - 6 Months",
"7_to_9months" = "7 - 9 Months",
"10_to_12months" = "10 - 12 Months")))
p <- p + geom_text(data = fitstats_df, aes(x = -8, y = 0.9, label = paste("RMSE ==", round(fitstats_df$RMSE, 2))), parse = TRUE)
p <- p + xlab("log(Mean Relative Abundance)")
p <- p + ylab("Prevalence")
p <- p + theme(
panel.background = element_rect(fill = "transparent",colour = NA),
plot.background = element_rect(fill = "transparent",colour = NA),
legend.background = element_rect(fill = "transparent",colour = NA),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
legend.key = element_rect(fill = "transparent",colour = NA))
file_name <- paste0("Supp_Fig_9")
library(cowplot)
p_legend <- ggdraw(plot_grid(get_legend(p)))
pdf(paste0(SavePath, file_name, "_legend", ".pdf"), width=2, height = 2)
print(p_legend)
invisible(dev.off())
d <- p + theme(legend.position="none")
g <- ggplot_gtable(ggplot_build(d))
#To color in Both the top and right strips
strip_both <- which(grepl('strip-', g$layout$name))
red_colfunc <- colorRampPalette(c("white", "red3"))
fills <- c("Bolivia", "Bangladesh", "Finland")
fills <- c(red_colfunc(4), Country_pal[fills])
k <- 1
for (i in strip_both) {
j <- which(grepl('rect', g$grobs[[i]]$grobs[[1]]$childrenOrder))
g$grobs[[i]]$grobs[[1]]$children[[j]]$gp$fill <- fills[k]
k <- k+1
}
grid.draw(g)
invisible(dev.off())
pdf(paste0(SavePath, file_name, ".pdf"), width=8, height = 5)
grid.draw(g)
invisible(dev.off())
# Chunk 10: Fig. 4b
# plot fit stats
fitstats_mdf <- melt(fitstats_df[,c("Above_Prediction","As_Predicted","Below_Prediction","Country","Age_Group")], id.vars = c("Country", "Age_Group"))
fitstats_mdf$Country <- factor(fitstats_mdf$Country, levels = c("Finland", "Bolivia", "Bangladesh"))
fitstats_mdf$Age_Group <- factor(fitstats_mdf$Age_Group, levels = age_group_list)
p <- ggplot(fitstats_mdf)
p <- p + geom_bar(aes(x = Age_Group, y = value, fill = variable), stat = "identity")
p <- p + facet_grid(Country~.)
p <- p + scale_fill_manual(name = "Prediction",
values = Prediction_pal,
labels = c("Above Prediction",
"As Predicted",
"Below Prediction"))
p <- p + scale_x_discrete(labels= c("1-3", "4-6", "7-9", "10-12"))
p <- p + xlab("Age (Months)")
p <- p + ylab("ASVs")
p <- p + theme(
panel.background = element_rect(fill = "transparent",colour = NA),
plot.background = element_rect(fill = "transparent",colour = NA),
legend.background = element_rect(fill = "transparent",colour = NA),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
legend.key = element_rect(fill = "transparent",colour = NA))
file_name <- paste0("Fig_4b")
library(cowplot)
p_legend <- ggdraw(plot_grid(get_legend(p)))
pdf(paste0(SavePath, file_name, "_legend", ".pdf"), width=2, height = 2)
print(p_legend)
invisible(dev.off())
d <- p + theme(legend.position="none")
g <- ggplot_gtable(ggplot_build(d))
#To color in just the right strips
strip_r <- which(grepl('strip-r', g$layout$name))
fills <- c("Finland", "Bolivia", "Bangladesh")
fills <- c(Country_pal[fills])
k <- 1
for (i in strip_r) {
j <- which(grepl('rect', g$grobs[[i]]$grobs[[1]]$childrenOrder))
g$grobs[[i]]$grobs[[1]]$children[[j]]$gp$fill <- fills[k]
k <- k+1
}
grid.draw(g)
invisible(dev.off())
pdf(paste0(SavePath, file_name, ".pdf"), width=2.5, height = 4.5)
grid.draw(g)
invisible(dev.off())
# Chunk 11: Fig. 4d - migration rate
fitstats_df$Country <- factor(fitstats_df$Country, levels = c("Finland", "Bolivia", "Bangladesh"))
p <- ggplot(fitstats_df)
p <- p + geom_line(aes(x = Age_Group, y = Migration_Rate, color = Country, group= Country))
p <- p + geom_linerange(aes(x = Age_Group, ymin = Migration_Rate - Migration_Rate_CI, ymax = Migration_Rate + Migration_Rate_CI, color = Country), show.legend = FALSE)
p <- p + geom_point(aes(x = Age_Group, y = Migration_Rate, fill = Country, shape = Country), color = "black", size = 2)
p <- p + scale_shape_manual(name = "Country", values = Country_shape_pal)
p <- p + scale_fill_manual(name = "Country", values = Country_pal)
p <- p + scale_color_manual(name = "Country", values = Country_pal)
p <- p + scale_x_discrete(name = "Age (months)", labels = c("1-3", "4-6", "7-9", "10-12"))
p <- p + xlab("Age (Months)")
p <- p + ylab("Estimated Migration Rate (m)")
p <- p + theme(
panel.background = element_rect(fill = "transparent",colour = NA),
plot.background = element_rect(fill = "transparent",colour = NA),
legend.background = element_rect(fill = "transparent",colour = NA),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
legend.key = element_rect(fill = "transparent",colour = NA))
p
file_name <- paste0("Fig_4d")
library(cowplot)
p_legend <- ggdraw(plot_grid(get_legend(p)))
pdf(paste0(SavePath, file_name, "_legend", ".pdf"), width=2, height = 3)
print(p_legend)
invisible(dev.off())
p2 <- p + theme(legend.position="none")
pdf(paste0(SavePath, file_name, ".pdf"), width=2.5, height = 2.5)
print(p2)
invisible(dev.off())
# Chunk 12: Fig. 4c partitiion PCA
# merge datasets
Model_Fit_groups <- as.list(paste0(rep(rownames(fitstats_df), each = 3), c("_Above_Prediction", "_As_Predicted", "_Below_Prediction"),"_ps"))
sample_set <- vector(mode="list", length=length(Model_Fit_groups))
names(sample_set) <- Model_Fit_groups
sample_set <- lapply(Model_Fit_groups, function(x) eval(as.name(paste(x))))
Model_Fit_ps <- do.call(merge_phyloseq, sample_set)
Model_Fit_ps <- prune_samples(sample_sums(Model_Fit_ps) > 0, Model_Fit_ps)
Model_Fit_ps <- prune_taxa(taxa_sums(Model_Fit_ps) > 0, Model_Fit_ps)
Model_Fit_ps <- merge_phyloseq(Model_Fit_ps, phy_tree(ps0))
ps <- Model_Fit_ps
set.seed(8675309)
ps_ord <- phyloseq::distance(ps, method = "jaccard", normalized=TRUE, binary = TRUE)
ord_PCoA <- ordinate(ps, "PCoA", distance = ps_ord)
PC1 <- round(ord_PCoA$values$Relative_eig[1]*100, 1)
PC2 <- round(ord_PCoA$values$Relative_eig[2]*100, 1)
PC3 <- round(ord_PCoA$values$Relative_eig[3]*100, 1)
PC4 <- round(ord_PCoA$values$Relative_eig[4]*100, 1)
pcVar <- PC1 + PC2 + PC3 + PC4
df <- cbind(ord_PCoA$vectors, sample_data(ps))
df$Age_Group <- factor(df$Age_Group, levels = age_group_list)
df$Country <- factor(df$Country, levels = c("Finland", "Bolivia", "Bangladesh"))
p <- ggplot(df, aes(x = Axis.1, y = Axis.2))
p <- p + geom_point(aes(fill = Prediction, shape = Country, size = Age_Group), color="black", alpha=0.75)
p <- p +  scale_shape_manual(name = "Country", values = Country_shape_pal)
p <- p +  scale_fill_manual(name = "Partition",
values = Prediction_pal,
labels = c("Above Prediction", "As Predicted", "Below Prediction"))
p <- p +  scale_size_manual(name = "Age Group",
values = c(2,3,4,5),
labels = c("1-3 Months", "4-6 Months", "7-9 Months", "10-12 Months"))
p <- p + xlab(paste0("PC1 (", PC1, "%)"))
p <- p + ylab(paste0("PC2 (", PC2, "%)"))
p <- p + coord_fixed(sqrt(PC2 / PC1))
p <- p + ylim(-0.33, 0.33)
p <- p + theme(
panel.background = element_rect(fill = "transparent",colour = NA),
plot.background = element_rect(fill = "transparent",colour = NA),
legend.background = element_rect(fill = "transparent",colour = NA),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
legend.key = element_rect(fill = "transparent",colour = NA))
p <- p + guides(
fill = guide_legend(override.aes=list(shape=c(21), size = c(4)), order=1),
size = guide_legend(order=3),
shape = guide_legend(override.aes=list(size = c(4)), order=2)
)
p
file_name <- paste0("Fig_4c")
library(cowplot)
p_legend <- ggdraw(plot_grid(get_legend(p)))
pdf(paste0(SavePath, file_name, "_legend", ".pdf"), width=3, height = 5)
print(p_legend)
invisible(dev.off())
p2 <- p + theme(legend.position="none")
pdf(paste0(SavePath, file_name, ".pdf"), width=4, height = 4)
print(p2)
invisible(dev.off())
# Chunk 13: Fig. 4e - heatmap
require("pheatmap")
Tsimane_ps@sam_data$Months_After_Birth <- as.numeric(as.character(Tsimane_ps@sam_data$Days_After_Birth))/30
ps <- Tsimane_ps
ps <- subset_samples(ps, Age_Class %in% c("Infant"))
ps <- subset_samples(ps, Sample_Type %in% c("Feces"))
ps <- subset_samples(ps, Country %in% c("Bolivia", "Finland", "Bangladesh"))
ps <- prune_taxa(taxa_sums(ps) > 0, ps)
ps@sam_data$Days_After_Birth <- as.numeric(as.character(ps@sam_data$Days_After_Birth))
ps@sam_data$Age_Months <- as.numeric(as.character(ps@sam_data$Age_Months))
ps <- subset_samples(ps, Age_Months <= 12)
ps0 <- Model_Fit_ps
ps0 <- subset_samples(ps0, Prediction == "Above_Prediction")
ps0 <- prune_taxa(taxa_sums(ps0) > 0, ps0)
taxa_to_keep <- taxa_names(ps0)
ps <- prune_taxa(taxa_to_keep, ps)
ps <- rarefy_even_depth(ps,sample.size =1000, rngseed=8675309)
table(ps@sam_data$Country)
# randomly sample Finnish and Bangladesh datasets to the number of samples in the Bolivian samples
Bolivia_ps <- subset_samples(ps, Country == "Bolivia")
range(Bolivia_ps@sam_data$Age_Months)
n <- nsamples(Bolivia_ps)
Finland_ps <- subset_samples(ps, Country == "Finland")
set.seed(8675309)
n_Finland <- sample(sample_names(Finland_ps), n, replace = FALSE)
Finland_ps <- subset_samples(Finland_ps, sample_names(Finland_ps) %in% n_Finland)
range(Finland_ps@sam_data$Age_Months)
Bangladesh_ps <- subset_samples(ps, Country == "Bangladesh")
set.seed(8675309)
n_Bangladesh <- sample(sample_names(Bangladesh_ps), n, replace = FALSE)
Bangladesh_ps <- subset_samples(Bangladesh_ps, sample_names(Bangladesh_ps) %in% n_Bangladesh)
range(Bangladesh_ps@sam_data$Age_Months)
ps <- merge_phyloseq(Bolivia_ps, Finland_ps, Bangladesh_ps)
ps <- filter_taxa(ps, function(x) sum(x > 1) > (0.10*length(x)), TRUE)
df <- data.frame(otu_table(ps)@.Data)
sd <- data.frame(sample_data(ps))[,c("Age_Months", "Country")]
sd$Country <- factor(sd$Country, levels = c("Finland", "Bolivia", "Bangladesh"))
sd$Age_Months <- as.numeric(as.character(sd$Age_Months))
sd <- with(sd, sd[order(Country, Age_Months),])
colnames(sd) <- c( "Age (Months)", "Country")
df <- df[rownames(sd),]
df <- t(df)
red_colfunc <- colorRampPalette(c("white", "red3"))
colorends <- red_colfunc(10)
annotation_colors <- list(colorends, Country_pal[c(2, 1, 3)])
names(annotation_colors) <- c("Age (Months)", "Country")
tt <- data.frame(tax_table(ps)@.Data)
rownames(df) <- paste("ASV", sapply(strsplit(rownames(tt), "_"), `[`, 2), tt[,"lowest_rank"])
x <- grep("\\+", rownames(df))
rownames(df)[x] <- paste("ASV", sapply(strsplit(rownames(tt)[x], "_"), `[`, 2), tt[x,"Genus"])
rownames(df) <- gsub("_", " ", rownames(df))
p <- pheatmap(
mat               = log10(df+1),
treeheight_col    = 0,
treeheight_row    = 25,
cluster_cols      = FALSE,
cluster_rows      = TRUE,
clustering_method = "ward.D",
show_colnames     = FALSE,
show_rownames     = TRUE,
fontsize_row      = 7,
annotation_colors = annotation_colors,
annotation_legend = FALSE,
drop_levels       = TRUE,
gaps_col          = unique(cumsum(table(sd$Country))),
border_color       = FALSE,
annotation_col    = sd)
file_name <- "Fig_4e"
pdf(paste0(SavePath, file_name, ".pdf"), width=9, height = 3)
p
invisible(dev.off())
table(sd$Country)
require("pheatmap")
Tsimane_ps@sam_data$Months_After_Birth <- as.numeric(as.character(Tsimane_ps@sam_data$Days_After_Birth))/30
ps <- Tsimane_ps
ps <- subset_samples(ps, Age_Class %in% c("Infant"))
ps <- subset_samples(ps, Sample_Type %in% c("Feces"))
ps <- subset_samples(ps, Country %in% c("Bolivia", "Finland", "Bangladesh"))
ps <- prune_taxa(taxa_sums(ps) > 0, ps)
ps@sam_data$Days_After_Birth <- as.numeric(as.character(ps@sam_data$Days_After_Birth))
ps@sam_data$Age_Months <- as.numeric(as.character(ps@sam_data$Age_Months))
ps <- subset_samples(ps, Age_Months <= 12)
ps0 <- Model_Fit_ps
ps0 <- subset_samples(ps0, Prediction == "Above_Prediction")
ps0 <- prune_taxa(taxa_sums(ps0) > 0, ps0)
taxa_to_keep <- taxa_names(ps0)
ps <- prune_taxa(taxa_to_keep, ps)
ps <- rarefy_even_depth(ps,sample.size =1000, rngseed=8675309)
table(ps@sam_data$Country)
# randomly sample Finnish and Bangladesh datasets to the number of samples in the Bolivian samples
Bolivia_ps <- subset_samples(ps, Country == "Bolivia")
range(Bolivia_ps@sam_data$Age_Months)
n <- nsamples(Bolivia_ps)
Finland_ps <- subset_samples(ps, Country == "Finland")
set.seed(8675309)
n_Finland <- sample(sample_names(Finland_ps), n, replace = FALSE)
Finland_ps <- subset_samples(Finland_ps, sample_names(Finland_ps) %in% n_Finland)
range(Finland_ps@sam_data$Age_Months)
Bangladesh_ps <- subset_samples(ps, Country == "Bangladesh")
set.seed(8675309)
n_Bangladesh <- sample(sample_names(Bangladesh_ps), n, replace = FALSE)
Bangladesh_ps <- subset_samples(Bangladesh_ps, sample_names(Bangladesh_ps) %in% n_Bangladesh)
range(Bangladesh_ps@sam_data$Age_Months)
ps <- merge_phyloseq(Bolivia_ps, Finland_ps, Bangladesh_ps)
ps <- filter_taxa(ps, function(x) sum(x > 1) > (0.10*length(x)), TRUE)
df <- data.frame(otu_table(ps)@.Data)
sd <- data.frame(sample_data(ps))[,c("Age_Months", "Country")]
sd$Country <- factor(sd$Country, levels = c("Finland", "Bolivia", "Bangladesh"))
sd$Age_Months <- as.numeric(as.character(sd$Age_Months))
sd <- with(sd, sd[order(Country, Age_Months),])
colnames(sd) <- c( "Age (Months)", "Country")
df <- df[rownames(sd),]
df <- t(df)
red_colfunc <- colorRampPalette(c("white", "red3"))
colorends <- red_colfunc(10)
annotation_colors <- list(colorends, Country_pal[c(2, 1, 3)])
names(annotation_colors) <- c("Age (Months)", "Country")
tt <- data.frame(tax_table(ps)@.Data)
rownames(df) <- paste("ASV", sapply(strsplit(rownames(tt), "_"), `[`, 2), tt[,"lowest_rank"])
x <- grep("\\+", rownames(df))
rownames(df)[x] <- paste("ASV", sapply(strsplit(rownames(tt)[x], "_"), `[`, 2), tt[x,"Genus"])
rownames(df) <- gsub("_", " ", rownames(df))
p <- pheatmap(
mat               = log10(df+1),
treeheight_col    = 0,
treeheight_row    = 25,
cluster_cols      = FALSE,
cluster_rows      = TRUE,
clustering_method = "ward.D",
show_colnames     = FALSE,
show_rownames     = TRUE,
fontsize_row      = 7,
annotation_colors = annotation_colors,
annotation_legend = FALSE,
drop_levels       = TRUE,
gaps_col          = unique(cumsum(table(sd$Country))),
border_color       = FALSE,
annotation_col    = sd)
file_name <- "Fig_4e"
pdf(paste0(SavePath, file_name, ".pdf"), width=9, height = 3)
p
invisible(dev.off())
table(sd$Country)
require("pheatmap")
Tsimane_ps@sam_data$Months_After_Birth <- as.numeric(as.character(Tsimane_ps@sam_data$Days_After_Birth))/30
ps <- Tsimane_ps
ps <- subset_samples(ps, Age_Class %in% c("Infant"))
ps <- subset_samples(ps, Sample_Type %in% c("Feces"))
ps <- subset_samples(ps, Country %in% c("Bolivia", "Finland", "Bangladesh"))
ps <- prune_taxa(taxa_sums(ps) > 0, ps)
ps@sam_data$Days_After_Birth <- as.numeric(as.character(ps@sam_data$Days_After_Birth))
ps@sam_data$Age_Months <- as.numeric(as.character(ps@sam_data$Age_Months))
ps <- subset_samples(ps, Age_Months <= 12)
ps0 <- Model_Fit_ps
ps0 <- subset_samples(ps0, Prediction == "Above_Prediction")
ps0 <- prune_taxa(taxa_sums(ps0) > 0, ps0)
taxa_to_keep <- taxa_names(ps0)
ps <- prune_taxa(taxa_to_keep, ps)
ps <- rarefy_even_depth(ps,sample.size =1000, rngseed=8675309)
table(ps@sam_data$Country)
# randomly sample Finnish and Bangladesh datasets to the number of samples in the Bolivian samples
Bolivia_ps <- subset_samples(ps, Country == "Bolivia")
range(Bolivia_ps@sam_data$Age_Months)
n <- nsamples(Bolivia_ps)
Finland_ps <- subset_samples(ps, Country == "Finland")
set.seed(8675309)
n_Finland <- sample(sample_names(Finland_ps), n, replace = FALSE)
Finland_ps <- subset_samples(Finland_ps, sample_names(Finland_ps) %in% n_Finland)
range(Finland_ps@sam_data$Age_Months)
Bangladesh_ps <- subset_samples(ps, Country == "Bangladesh")
set.seed(8675309)
n_Bangladesh <- sample(sample_names(Bangladesh_ps), n, replace = FALSE)
Bangladesh_ps <- subset_samples(Bangladesh_ps, sample_names(Bangladesh_ps) %in% n_Bangladesh)
range(Bangladesh_ps@sam_data$Age_Months)
ps <- merge_phyloseq(Bolivia_ps, Finland_ps, Bangladesh_ps)
ps <- filter_taxa(ps, function(x) sum(x > 1) > (0.10*length(x)), TRUE)
df <- data.frame(otu_table(ps)@.Data)
sd <- data.frame(sample_data(ps))[,c("Age_Months", "Country")]
sd$Country <- factor(sd$Country, levels = c("Finland", "Bolivia", "Bangladesh"))
sd$Age_Months <- as.numeric(as.character(sd$Age_Months))
sd <- with(sd, sd[order(Country, Age_Months),])
colnames(sd) <- c( "Age (Months)", "Country")
df <- df[rownames(sd),]
df <- t(df)
red_colfunc <- colorRampPalette(c("white", "red3"))
colorends <- red_colfunc(10)
annotation_colors <- list(colorends, Country_pal[c(2, 1, 3)])
names(annotation_colors) <- c("Age (Months)", "Country")
tt <- data.frame(tax_table(ps)@.Data)
rownames(df) <- paste("ASV", sapply(strsplit(rownames(tt), "_"), `[`, 2), tt[,"lowest_rank"])
x <- grep("\\+", rownames(df))
rownames(df)[x] <- paste("ASV", sapply(strsplit(rownames(tt)[x], "_"), `[`, 2), tt[x,"Genus"])
rownames(df) <- gsub("_", " ", rownames(df))
p <- pheatmap(
mat               = log10(df+1),
treeheight_col    = 0,
treeheight_row    = 25,
cluster_cols      = FALSE,
cluster_rows      = TRUE,
clustering_method = "ward.D",
show_colnames     = FALSE,
show_rownames     = TRUE,
fontsize_row      = 7,
annotation_colors = annotation_colors,
annotation_legend = FALSE,
drop_levels       = TRUE,
gaps_col          = unique(cumsum(table(sd$Country))),
border_color       = FALSE,
annotation_col    = sd)
file_name <- "Fig_4e"
pdf(paste0(SavePath, file_name, ".pdf"), width=9, height = 3)
p
invisible(dev.off())
table(sd$Country)
require("pheatmap")
Tsimane_ps@sam_data$Months_After_Birth <- as.numeric(as.character(Tsimane_ps@sam_data$Days_After_Birth))/30
ps <- Tsimane_ps
ps <- subset_samples(ps, Age_Class %in% c("Infant"))
ps <- subset_samples(ps, Sample_Type %in% c("Feces"))
ps <- subset_samples(ps, Country %in% c("Bolivia", "Finland", "Bangladesh"))
ps <- prune_taxa(taxa_sums(ps) > 0, ps)
ps@sam_data$Days_After_Birth <- as.numeric(as.character(ps@sam_data$Days_After_Birth))
ps@sam_data$Age_Months <- as.numeric(as.character(ps@sam_data$Age_Months))
ps <- subset_samples(ps, Age_Months <= 12)
ps0 <- Model_Fit_ps
ps0 <- subset_samples(ps0, Prediction == "Above_Prediction")
ps0 <- prune_taxa(taxa_sums(ps0) > 0, ps0)
taxa_to_keep <- taxa_names(ps0)
ps <- prune_taxa(taxa_to_keep, ps)
ps <- rarefy_even_depth(ps,sample.size =1000, rngseed=8675309)
table(ps@sam_data$Country)
# randomly sample Finnish and Bangladesh datasets to the number of samples in the Bolivian samples
Bolivia_ps <- subset_samples(ps, Country == "Bolivia")
range(Bolivia_ps@sam_data$Age_Months)
n <- nsamples(Bolivia_ps)
Finland_ps <- subset_samples(ps, Country == "Finland")
set.seed(8675309)
n_Finland <- sample(sample_names(Finland_ps), n, replace = FALSE)
Finland_ps <- subset_samples(Finland_ps, sample_names(Finland_ps) %in% n_Finland)
range(Finland_ps@sam_data$Age_Months)
Bangladesh_ps <- subset_samples(ps, Country == "Bangladesh")
set.seed(8675309)
n_Bangladesh <- sample(sample_names(Bangladesh_ps), n, replace = FALSE)
Bangladesh_ps <- subset_samples(Bangladesh_ps, sample_names(Bangladesh_ps) %in% n_Bangladesh)
range(Bangladesh_ps@sam_data$Age_Months)
ps <- merge_phyloseq(Bolivia_ps, Finland_ps, Bangladesh_ps)
ps <- filter_taxa(ps, function(x) sum(x > 1) > (0.10*length(x)), TRUE)
df <- data.frame(otu_table(ps)@.Data)
sd <- data.frame(sample_data(ps))[,c("Age_Months", "Country")]
sd$Country <- factor(sd$Country, levels = c("Finland", "Bolivia", "Bangladesh"))
sd$Age_Months <- as.numeric(as.character(sd$Age_Months))
sd <- with(sd, sd[order(Country, Age_Months),])
colnames(sd) <- c( "Age (Months)", "Country")
df <- df[rownames(sd),]
df <- t(df)
red_colfunc <- colorRampPalette(c("white", "red3"))
colorends <- red_colfunc(10)
annotation_colors <- list(colorends, Country_pal[c(2, 1, 3)])
names(annotation_colors) <- c("Age (Months)", "Country")
tt <- data.frame(tax_table(ps)@.Data)
rownames(df) <- paste("ASV", sapply(strsplit(rownames(tt), "_"), `[`, 2), tt[,"lowest_rank"])
x <- grep("\\+", rownames(df))
rownames(df)[x] <- paste("ASV", sapply(strsplit(rownames(tt)[x], "_"), `[`, 2), tt[x,"Genus"])
rownames(df) <- gsub("_", " ", rownames(df))
p <- pheatmap(
mat               = log10(df+1),
treeheight_col    = 0,
treeheight_row    = 25,
cluster_cols      = FALSE,
cluster_rows      = TRUE,
clustering_method = "ward.D",
show_colnames     = FALSE,
show_rownames     = TRUE,
fontsize_row      = 7,
annotation_colors = annotation_colors,
annotation_legend = FALSE,
drop_levels       = TRUE,
gaps_col          = unique(cumsum(table(sd$Country))),
border_color       = FALSE,
annotation_col    = sd)
file_name <- "Fig_4e"
pdf(paste0(SavePath, file_name, ".pdf"), width=9, height = 3)
p
invisible(dev.off())
table(sd$Country)
ps
head(sample_data(ps))
